home *** CD-ROM | disk | FTP | other *** search
/ Crack It! / Crack It!.iso / CONTENT / DISKEDIT / SCREENRT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-09-09  |  5KB  |  190 lines
  1. {
  2.  ***
  3.  
  4.  SCREENRT.PAS
  5.  Screen-related Routines
  6.  (C)Copyright Gerard Paul Java 1996
  7.  
  8.  Unit Source File
  9.  
  10.  Licensed material - program property of Fencer Software
  11.  
  12.  
  13.  This unit contains general routines related to the screen.  It contains
  14.  a box-drawing routine, the screen save/restore routines, a function that
  15.  returns a string of a particular character repeated, cursor-manipulation
  16.  routines, and the routines that save, set, and restore the screen mode.
  17.  It also contains a routine that sets both foreground and background colors
  18.  at once.
  19.  
  20.  ***
  21.  
  22. }
  23.  
  24.  
  25. {$A+,B-,F-,I-,N-,R-,S-,V-}
  26.  
  27. unit ScreenRt;
  28.  
  29. interface
  30.  
  31. type
  32.   OrigWindowType = object
  33.                      Min: word;
  34.                      Max: word;
  35.                      procedure Save;
  36.                      procedure Restore;
  37.                    end;
  38.  
  39.   ReptStrLenRange   = 1..80;
  40.  
  41.   Str80             = string[80];
  42.   Str78             = string[78];
  43.  
  44.   ScreenBufferType  = array[1..2000] of word;      { Buffer for screen saves/restores. }
  45.  
  46. const
  47.   SingleLine = False;
  48.   DoubleLine = True;
  49.  
  50. var
  51.   BoxAttr     : byte;
  52.   TextNormAttr: byte;
  53.   TextHighAttr: byte;
  54.  
  55. function StringOf(Character: char;Count: ReptStrLenRange): Str80;
  56. procedure DrawBox(X1,Y1,X2,Y2: byte;Style: boolean);
  57. procedure DivideBox(Col,Top,Bottom: byte);
  58. procedure SetCursor(ScanLines: word);
  59. inline($B4/$01/                { MOV  AH,1 }
  60.        $59/                    { POP  CX       ;ScanLines were pushed. }
  61.        $CD/$10);               { INT  $10 }
  62. procedure PutChar(X,Y,Character: byte);
  63. procedure SetTSSRValues;
  64. procedure SaveScreen(var ScreenBuffer: ScreenBufferType);
  65. procedure RestoreScreen(var ScreenBuffer: ScreenBufferType);
  66.  
  67. implementation
  68. uses
  69.   Crt;
  70.  
  71. const
  72.   Space = ' ';
  73.   Null  = '';
  74.  
  75.  
  76. {---------------------------------------------------------------------------
  77.  StringOf: Returns a string consisting of Count occurences of a character.
  78.  ---------------------------------------------------------------------------}
  79.  
  80. function StringOf(Character: char;Count: ReptStrLenRange): Str80; external;
  81. {$L STRINGOF.OBJ}
  82.  
  83.  
  84. {---------------------------------------------------------------------------
  85.  Box: Creates a box on the screen. The box has spaces within it, so any
  86.  characters on the screen within the boundaries of the box are erased.  The
  87.  high-level ASCII characters ╔ (201), ╗ (187), ╚ (200), ╝ (188), ═ (205),
  88.  and ║ (186) are used to create the box.
  89.  ---------------------------------------------------------------------------}
  90.  
  91. procedure DrawBox(X1,Y1,X2,Y2: byte;Style: boolean);
  92. var
  93.   ULeftChar,
  94.   LLeftChar,
  95.   URightChar,
  96.   LRightChar,
  97.  
  98.   HorBarChar,
  99.   VerBarChar: char;
  100.  
  101.   Wid         : byte;
  102.  
  103.   Row         : byte;
  104.  
  105.   HorzBar     : Str78;
  106.   InSpaces    : Str78;
  107.  
  108. begin { proc }
  109.   case Style of
  110.     SingleLine: begin
  111.                   ULeftChar := #218;
  112.                   LLeftChar := #192;
  113.                   URightChar := #191;
  114.                   LRightChar := #217;
  115.  
  116.                   HorBarChar := #196;
  117.                   VerBarChar := #179;
  118.                 end;
  119.     DoubleLine: begin
  120.                   ULeftChar := #201;
  121.                   LLeftChar := #200;
  122.                   URightChar := #187;
  123.                   LRightChar := #188;
  124.  
  125.                   HorBarChar := #205;
  126.                   VerBarChar := #186;
  127.                 end;
  128.   end;
  129.   Wid := X2-X1-1;                               { Calculate box width. }
  130.  
  131.   HorzBar := StringOf(HorBarChar,Wid);
  132.   InSpaces := StringOf(Space,Wid);
  133.  
  134.   GotoXY(X1,Y1);Write(ULeftChar,HorzBar,URightChar);
  135.  
  136.   for Row := Y1+1 to Y2-1 do
  137.     begin { for }
  138.       GotoXY(X1,Row);
  139.       Write(VerBarChar,InSpaces,VerBarChar);
  140.     end; { for }
  141.  
  142.   GotoXY(X1,Y2);Write(LLeftChar,HorzBar,LRightChar);
  143. end; { proc }
  144.  
  145. procedure DivideBox(Col,Top,Bottom: byte);
  146. var
  147.   Ctr: byte;
  148.  
  149. begin
  150.   GotoXY(Col,Top);Write(#209);
  151.   GotoXY(Col,Bottom);Write(#207);
  152.  
  153.   for Ctr := Top+1 to Bottom-1 do
  154.     begin
  155.       GotoXY(Col,Ctr);Write(#179);
  156.     end;
  157. end;
  158.  
  159. procedure OrigWindowType.Save;
  160. begin
  161.   Min := WindMin;
  162.   Max := WindMax;
  163. end;
  164.  
  165. procedure OrigWindowType.Restore;
  166. begin
  167.   WindMin := Min;
  168.   WindMax := Max;
  169. end;
  170.  
  171. {---------------------------------------------------------------------------
  172.  These are the external screen save/restore routines.  SetTSSRValues
  173.  determines the video configuration and sets the proper values for the
  174.  screen segment and other variables to work with.  SaveScreen saves the
  175.  screen in a 2000-word array variable, and RestoreScreen copies the contents
  176.  of the array variable back to the screen.
  177.  ---------------------------------------------------------------------------}
  178.  
  179. {$L PUTCHAR.OBJ}
  180.  
  181. procedure PutChar; external;
  182.  
  183. {$L TSSR.OBJ}                       { Link in screen save/restore routines. }
  184.  
  185. procedure SetTSSRValues; external;
  186. procedure SaveScreen; external;
  187. procedure RestoreScreen; external;
  188.  
  189. end.
  190.